#!/usr/bin/perl -w

package sock;
use Socket;
use Exporter;
@ISA=(Exporter);
@EXPORT=qw(wconnect communicate get_body *SOCKET %fields sock_prepare $host);
use constant DEBUG => 1;

our ($paddr,$iaddr)=('','');
our %fields=();
our $set_cookie;

our $host;
sub sock_prepare
{
  $host="$_[0]:$_[1]";
  $iaddr = (gethostbyname($_[0]))[4];
  $paddr = sockaddr_in($_[1], $iaddr);
}

sub wconnect($)
{
  print $_[0],$\?'':"\n" if $_[0];
  socket(SOCKET, PF_INET, SOCK_STREAM, 6) || die "socket: $!";
  until (connect(SOCKET, $paddr)) {warn("connect: $!");sleep 10}
}

sub communicate($$) # open socket and send request
{
#  print STDERR "$_[0] " if $_[0];
#  &wconnect;
  send SOCKET, $_[1], 0;

print STDERR "Sent <<<<<<<<\n$_[1]>>>>>>>>>>>>\n" if DEBUG;

# get & parse http header

my $answer;
%fields=();
while (<SOCKET>)
{
print STDERR if DEBUG;

  last if /^\s*\r?\n/s;
  if (!$answer)
  {
    $answer=$_;
    close(SOCKET), warn "Unrecognized server answer: $answer" unless m[^HTTP/1.\d (\d\d\d) (.*?)\r?\n$]s;
  }
  else {
    my ($field, $value)=/^(.*?): ([^\r]*)\r?$/;
    ($value,$set_cookie)=split /;/, $value, 2 if $field eq 'Set-Cookie';    
    $fields{$field}=$value unless exists $fields{$field};
  }
}
  return $answer;
}

sub get_body {undef local $/;$_=<SOCKET>;close SOCKET;}

1;